home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol260 / boostref.arc / BOREF2.WS < prev   
Encoding:
Text File  |  1986-09-24  |  20.9 KB  |  699 lines
  1.                                NSORBIT
  2.  
  3.  
  4. Declaration: Procedure NsOrbit ( X1 : ColumnType;
  5.                                  Y1 : RowType;
  6.                                  X2 : ColumnType;
  7.                                  Y2 : RowType;
  8.                               Style : Integer;
  9.                     NumberOfSeconds : Integer);
  10.  
  11. Purpose:     Draws a box at X1,Y1,X2,Y2 in selected Style, then      
  12.              erases all but two components of the box, which ì
  13.              orbit the box interior for time NumberOfSeconds.
  14.              After orbiting, NsOrbit redraws the original box.
  15.  
  16.  
  17.              Notes:
  18.              1.  Style is a value from 1 to 4 and controls theì
  19.                  number of lines in a box side (see Boxul ì
  20.                  description for details).
  21.  
  22.  
  23. Example:     Display 60 boxes and select one at random to orbit.
  24.  
  25.              (*$IBodecl  *)
  26.              (*$IPutStr  *)
  27.              (*$ICopies  *)
  28.              (*$IBoxul   *)
  29.              (*$ISetAtt  *)
  30.              (*$ITimer   *)
  31.              (*$INsOrbit *)
  32.              var
  33.                 Ulx, Uly : Integer;
  34.  
  35.              BEGIN
  36.  
  37.                 ClrScr;
  38.                 for i := 1 to 15 do
  39.                 begin
  40.                    Boxul (1+(i-1)*4,1,4+(i-1)*4,4,1,14);
  41.                    Boxul (1+(i-1)*4,6,4+(i-1)*4,9,2,14);
  42.                    Boxul (1+(i-1)*4,11,4+(i-1)*4,14,3,14);
  43.                    Boxul (1+(i-1)*4,16,4+(i-1)*4,19,4,14);
  44.                 end;
  45.                 PutStr (h,'Press enter to orbit',60,25,14);
  46.                 read;
  47.                 Randomize;
  48.                 Ulx := Random(15);
  49.                 Uly := Random( 4);
  50.                 NsOrbit (1+Ulx*4, 1+Uly*5, 4+Ulx*4, 4+Uly*5, Uly+1, 4);
  51.  
  52.              END (* XNsOrbit *) .
  53. .pa
  54. è                               OVERSTR
  55.  
  56.  
  57. Declaration: Function OverStr ( New, Target : AnyString;
  58.                                 Pos, Len    : Integer;
  59.                                 Pad         : Char) : AnyString;
  60.  
  61.  
  62. Purpose:     Overlays New onto Target beginning at Pos, for ì
  63.              length Len, then pads or truncates accordingly.
  64.  
  65.  
  66.              Notes:
  67.              1.  Padding occurs when Pos > length(Target) orì
  68.                  LEN > length(New).
  69.  
  70.  
  71. Example:     Modify and pad a string. 
  72.  
  73.              (*$IBodecl  *)
  74.              (*$IOverStr *)
  75.              (*$IPutStr  *)
  76.  
  77.              BEGIN
  78.                 ClrScr;
  79.                 S := 'Change this field '+#220+#223+#220+#223+
  80.                      #220+#223+' to an alternate pattern, '+
  81.                      'pad to end of line.';
  82.                 PutStr (h,S,1,1,14);
  83.                 read;
  84.                 PutStr (h,OverStr (#223+#220+#223+#220+#223+#220,
  85.                                    S,19,61,#223),1,1,14);
  86.  
  87.              END (* XOverStr *) .
  88. .pa
  89. è                                PUTSTR
  90.  
  91.  
  92. Declaration: Procedure PutStr ( HV : Char;
  93.                                  S : AnyString;
  94.                                  X : ColumnType;
  95.                                  Y : RowType;
  96.                                Att : Integer);
  97.  
  98.  
  99. Purpose:     Writes S to video display beginning at X,Y, with ì
  100.              display attribute Att.
  101.   
  102.              Notes:ì
  103.              1.  If HV  = 'V', direction of write is vertical.  Ifì
  104.              HV is any other character, direction of write is ì
  105.              horizontal.  
  106.              2.  PutHeap is the corresponding Heap I/O routine.
  107.  
  108.  
  109. Example:     Create screens using Write, PutStr, and Heap I/O.
  110.  
  111.              (*$IBoDecl   *)
  112.              (*$IPutStr   *)
  113.              (*$ICenter   *)
  114.              (*$ISaves    *)
  115.              (*$IRestores *)
  116.              (*$IPutHeap  *)
  117.  
  118.              BEGIN
  119.  
  120.                 Mark ( HeapTop );
  121.                 New ( page[1] );
  122.                 ClrScr;
  123.                 for i := 1 to 25 do
  124.                    writeln('Using Orthodox methods of screen I/O');
  125.                 SaveScreen ( page[1] );
  126.                 read;
  127.                 for i := 1 to 25 do
  128.                    PutStr (h,Center(' Using PutStr with Center function ',
  129.                            40,' '),41,i,112);
  130.                read;
  131.                ClrScr;
  132.                read;
  133.                for i := 1 to 25 do
  134.                   PutHeap ( page[1], h,Center(' Used PutHeap and'+
  135.                           ' RestoreScreen ',40,' '),41,i,112);
  136.                RestoreScreen ( page[1] );
  137.                Release ( HeapTop );
  138.  
  139.             END (* XPutStr *) .
  140. .pa
  141. è                                REMBLK
  142.  
  143.  
  144. Declaration: Procedure RemBlk ( X1 : ColumnType;
  145.                                 Y1 : RowType;
  146.                                 X2 : ColumnType;
  147.                                 Y2 : RowType);
  148.  
  149.  
  150. Purpose:     Removes the block at display location 
  151.              X1,Y1,X2,Y2 by filling it with blanks.
  152.  
  153.              Notes:
  154.              1.  The attribute byte of the blanked area is 
  155.                  set to 14 (intense yellow).
  156.              2.  Use FillHeap to remove areas of the heap.
  157.  
  158.  
  159. Example:     Fill the screen with alternate ones and zeroes, then ì
  160.              remove the zeroes.
  161.  
  162.              (*$IBoDecl *)
  163.              (*$IRemBlk *)
  164.              (*$IPutStr *)
  165.  
  166.              var  j : integer;
  167.  
  168.              BEGIN
  169.  
  170.                 repeat
  171.                    for i := 1 to 25 do
  172.                       for j := 1 to 8 do
  173.                          PutStr (h,'1010101010',1+(j-1)*10,i,14);
  174.                    read(Kbd,ch);
  175.                    for j := 1 to 40 do
  176.                       RemBlk (2+(j-1)*2,1,2+(j-1)*2,25);
  177.                    read(Kbd,ch);
  178.                 until ch = ' ';
  179.  
  180.              END (* XRemBlk *) .
  181. .pa
  182. è                                 RIGHT
  183.  
  184.  
  185. Declaration: Function Right ( S : AnyString;
  186.                             Len : Integer;
  187.                             Pad : Char): AnyString;    
  188.  
  189.  
  190. Purpose:     Returns S right-justified in a string of length Len,  
  191.              padded or truncated on the left as needed.
  192.  
  193.  
  194. Example:     Use right function to decimal-align monetary values.
  195.  
  196.              (*$IBoDecl *)
  197.              (*$IRight  *)
  198.              (*$IPutStr *)
  199.  
  200.              BEGIN
  201.  
  202.                 ClrScr;
  203.                 PutStr (h,Right ('0.12',12,' '),1,2,14);
  204.                 PutStr (h,Right ('77,126.99',12,' '),1,3,14);
  205.                 PutStr (h,Right ('1,345,200.06',12,' '),1,4,14);
  206.                 PutStr (h,Right ('35.00',12,' '),1,5,14);
  207.  
  208.              END (* XRight *) .
  209. .pa
  210. è                                 RWORD
  211.  
  212.  
  213.  
  214. Declaration: Function Rword (  S : AnyString;
  215.                                N : Integer;
  216.                               St : AnyString ) : AnyString;
  217.  
  218.  
  219. Purpose:     Replace word N of S with St.  All other words of
  220.              S (if any) remain unaffected.  
  221.  
  222.  
  223.              Notes:
  224.  
  225.              1.  A word is any blank-delimited sequence of
  226.                  characters or a string of nonblank characters.
  227.  
  228.              2.  If Length(Rword( S,N,St )) > 255, then St is
  229.                  reduced to fit.
  230.  
  231.  
  232. Example:     Replace the day of the week with the date.
  233.  
  234.  
  235.              Given:  S := 'Today is Friday';
  236.  
  237.              Then:   S := Rword ( S, 3, 'November 15, 1985');
  238.  
  239.              Yields: S := 'Today is November 15, 1985';
  240.  
  241.  
  242.              Note:
  243.  
  244.              1.  For a working routine using Rword and other
  245.                  word functions, see the example for Words.
  246. .pa
  247. è                  SAVE AND RESTORE SCREEN PROCEDURES
  248.  
  249.  
  250. Declaration: Procedure SaveScreen    ( Page : HeapBuf );
  251.              Procedure RestoreScreen ( Page : HeapBuf );
  252.  
  253.  
  254. Purpose:     Provide convenience and speed for saving and 
  255.              restoring contents of video display.  
  256.  
  257.              Notes:
  258.              1.  See BoDemo for additional examples
  259.                  of SaveScreen and RestoreScreen.
  260.  
  261. Example:     Create two screens, saving each, then alternately
  262.              restore them under user control.
  263.  
  264.              (*$IBoDecl *)
  265.              (*$ICopies *)
  266.              (*$ICenter *)
  267.              (*$IPutStr *)
  268.              (*$ISaves  *)
  269.              (*$IRestores *)
  270.  
  271.              BEGIN
  272.  
  273.                 Mark ( HeapTop );
  274.                 New  ( page[1] );
  275.                 New  ( page[2] );
  276.  
  277.                 for i := 1 to 25 do
  278.                    PutStr (h,Copies ( ' ' ,80), 1, i, 7 );
  279.                 PutStr (h, Center (' PRESS ANY KEY ',80,' ' ),1,13,7);
  280.                 SaveScreen ( page[1] );
  281.                 read(Kbd,ch);
  282.                 for i := 1 to 25 do
  283.                    PutStr (h,Center ( 'This is screen 2 - ' +
  284.                                       'press SpaceBar to quit',
  285.                                        80,' '),1,i,14);
  286.                 SaveScreen ( page[2] );
  287.                 read(Kbd,ch);
  288.                 repeat
  289.                    RestoreScreen ( page[1] );
  290.                    read(Kbd,ch);
  291.                    RestoreScreen ( page[2] );
  292.                    read(Kbd,ch);
  293.                 until ch = ' ';
  294.                 Release ( HeapTop );
  295.  
  296.              END (* XScreen *) .
  297. .pa 
  298. è                                SETATT 
  299.  
  300.  
  301. Declaration: Procedure SetAtt ( X1 : ColumnType;
  302.                                 Y1 : RowType;
  303.                                 X2 : ColumnType;
  304.                                 Y2 : RowType;
  305.                                Att : Integer);
  306.  
  307.  
  308. Purpose:     Sets the video attributes of the block defined by 
  309.              X1,Y1,X2,Y2 according to the value of Att.
  310.  
  311.              Notes:
  312.              1.  HeapAt sets attributes for pages on the heap.
  313.  
  314.  
  315. Example:     Draw 20 bars, then allow the user to set their ì
  316.              attributes.
  317.  
  318.              (*$IBoDecl *)
  319.              (*$ISetAtt *)
  320.              (*$IPutStr *)
  321.  
  322.              var
  323.                 j, Att : integer;
  324.      
  325.              BEGIN
  326.  
  327.                 ClrScr;
  328.                 for i := 1 to 6 do
  329.                    for j := 1 to 20 do
  330.                       PutStr (h,#04 +#04 +#04 , 1+(j-1)*4, 7-i, 14);
  331.  
  332.                 repeat
  333.                    PutStr (h, 'Enter attribute value,'+
  334.                          ' 0-255 (Out of Range quits) ',
  335.                            1,10,14);
  336.                    ClrEol;
  337.                    read(att);
  338.                    if (att >= 0) and (att <= 255) then
  339.                       for i := 1 to 20 do
  340.                          SetAtt (1+(i-1)*4,1,3+(i-1)*4,6,att);
  341.                 until (att < 0) or (att > 255);
  342.  
  343.              END (* XSetatt *) .
  344. .pa
  345. è                                 SPACE
  346.  
  347.  
  348. Declaration: Function Space ( S : AnyString ) : AnyString;
  349.  
  350.  
  351. Purpose:     Returns a string that is S normalized.  A 
  352.              normalized string has no leading or trailing
  353.              blanks and one blank between each word.
  354.  
  355.  
  356.              Notes:
  357.  
  358.              1.  A word is any blank-delimited sequence of 
  359.                  characters or a string of nonblank characters.
  360.  
  361.  
  362. Example:     Normalize a string.
  363.  
  364.  
  365.              Given:   S := '   X   Y   Z   ';
  366.  
  367.              Then:    S := Space ( S );
  368.  
  369.              Yields:  S := 'X Y Z';
  370.  
  371.  
  372.              Note:
  373.  
  374.              1.  For a working routine using Space and other
  375.                  word functions, see the example for Words.
  376. .pa
  377. è                                 STRIP
  378.  
  379.  
  380. Declaration: Function Strip ( S : AnyString;
  381.                               C : Char) : AnyString;
  382.  
  383.  
  384. Purpose:     Copies S to the result string, excluding leading      ì
  385.              and trailing C characters. 
  386.  
  387.  
  388. Example:     Isolate the dollar sign.
  389.  
  390.              (*$IBoDecl *)
  391.              (*$IStrip  *)
  392.              (*$IPutStr *)
  393.  
  394.              BEGIN
  395.  
  396.                 ClrScr;
  397.                 S := '   111222333444$444333222111   ';
  398.                 PutStr (h, s, 1,1,14);
  399.                 read;
  400.                 PutStr (h, strip (strip ( strip ( strip (strip   
  401.                 (S,' ') ,'1'),'2'),'3'),'4'),1,2,14);
  402.  
  403.              END (* Xstrip *) . 
  404. .pa
  405. è                                  TIMER
  406.  
  407.  
  408. Declaration: Function Timer (Seconds : Integer ) : Boolean;ì
  409.                     ì
  410.  
  411. Purpose:     Returns TRUE if Seconds seconds have elapsed since   ì
  412.              Timer's invocation.
  413.  
  414.              Notes:
  415.              1.  StartElapsed and TimeElapsed arσ globals. ì
  416.                  StartElapsed must be initialized to FALSE.  Both ì
  417.                  are part of BoDecl (Boosters Declarations file). ì
  418.  
  419.              2.  Timer uses the system clock (seconds value) to ì
  420.                  keep track of the time elapsed.  The hundredth ì
  421.                  value of the clock is set to zero when the ì
  422.                  timing begins, to ensure a full initial second.ì
  423.  
  424.              3.  Calls to Timer should not be nested.
  425.  
  426.              4.  See the Wait procedure for an illustration
  427.                  of how to use Timer.
  428.  
  429. Example:     Demonstrate a five-second timing.
  430.  
  431.              var
  432.                 SaveTime : integer;
  433.  
  434.              (*$IBoDecl *)
  435.              (*$ITimer  *)
  436.              (*$IPutStr *)
  437.  
  438.              BEGIN
  439.  
  440.                 ClrScr;
  441.                 PutStr (h,'Set timer for 5 seconds. . .',30,6,14);
  442.                 i := 5;
  443.                 SaveTime := TimeElapsed;
  444.                 repeat
  445.                    if TimeElapsed <> SaveTime then
  446.                    begin
  447.                       str (i,s);
  448.                       PutStr (h,s, 40,12-i,14);
  449.                       i := i - 1;
  450.                       SaveTime := TimeElapsed;
  451.                    end;
  452.                 until Timer(5);
  453.                 PutStr (h,'Time''s up.',37,13,14);
  454.                 read;
  455.      
  456.              END (* Xtimer *) .
  457. .pa
  458. è                       SET AND DISPLAY SYSTEM TIME
  459.  
  460. Declaration: Procedure TimeXY ( X : ColumnType; Y : RowType);
  461.              Procedure Stime  ( hh, mm, ss : integer );
  462.  
  463. Purpose:     TimeXY displays the system time, while Stime sets it.
  464.  
  465. Example:     Allow user to set time while current time continually
  466.              displays.
  467.  
  468.              (*$IBoDecl *)
  469.              (*$IPutStr *)
  470.              (*$ITimeXY *)
  471.              (*$IStime  *)
  472.  
  473.              var  hh, mm, ss : integer;
  474.  
  475.              function Range ( Ch: Char): boolean;
  476.              begin
  477.                 case Ch of
  478.                    #32,#48..#57 : Range := True
  479.                 else
  480.                    Range := false;
  481.                 end;
  482.              end;
  483.  
  484.              BEGIN
  485.                 ClrScr;
  486.                 S := '';
  487.                 PutStr ( h,'Current time: ',30,1, 14 );
  488.                 PutStr ( h, 'Enter new time exactly as shown',1, 9, 14);
  489.                 PutStr ( h, '      HH MM SS: ',1,10, 14);
  490.                 SaveX := 17;
  491.                 SaveY := 10;
  492.                 Repeat
  493.                    repeat
  494.                       TimeXY(44,1);
  495.                       GoToXY(SaveX,SaveY);
  496.                    until KeyPressed;
  497.                    read(Kbd,ch);
  498.                    if Range(ch) then
  499.                    begin
  500.                       S := S + ch;
  501.                       write(Ch);
  502.                       SaveX := WhereX;
  503.                    end;
  504.                 until Ch = #13;
  505.                 val ( Copy(S,1,2),hh,ecode );
  506.                 val ( Copy(S,4,2),mm,ecode );
  507.                 val ( Copy(S,7,2),ss,ecode );
  508.                 Stime ( hh,mm,ss );
  509.                 repeat TimeXY(44,1) until KeyPressed;
  510.              END (* XtimeXY *) .
  511. .pa
  512. è                                 UPPER
  513.  
  514.  
  515. Declaration: Function Upper ( S : AnyString) : AnyString;
  516.  
  517.  
  518. Purpose:     Provides uppercase translation as a function call.
  519.              Returns a string with all lowercase alphabeticsì
  520.              converted to uppercase.
  521.  
  522.  
  523.              Notes: 
  524.              1.  For a technique using a procedure call, see the ì
  525.                  Turbo Pascal manual.
  526.  
  527.  
  528. Example:     Translate user input to uppercase.
  529.  
  530.              (*$IBoDecl *)
  531.              (*$IUpper  *)
  532.              (*$ICenter *)
  533.  
  534.              BEGIN
  535.  
  536.                 ClrScr;
  537.                 Write ( Center ('Enter any string '+
  538.                       '(''quit'' quits)',80,' '));
  539.                 window(1,2,80,25);
  540.                 repeat
  541.                    readln(S);
  542.                    S := Upper( S );
  543.                    Writeln( S );
  544.                 until S = 'QUIT';
  545.                 window(1,1,80,25);
  546.  
  547.              END (* Xupper *) .
  548. .pa
  549. è                                WAIT
  550.  
  551.  
  552. Declaration: Procedure Wait ( NumberOfSeconds : Integer );
  553.  
  554. Purpose:     Delays processing for the number of seconds specified 
  555.              by NumberOfSeconds or until a key press.  If the key 
  556.              pressed was the Home key, processing halts until 
  557.              another key press.
  558.  
  559. Example:     Display 'steps' with 1-second intervals.
  560.  
  561.              (*$IBoDecl *)
  562.              (*$ITimer  *)
  563.              (*$ICenter *)
  564.              (*$IPutStr *)
  565.              (*$IWait   *)
  566.        
  567.              BEGIN
  568.          
  569.                 ClrScr;
  570.                 PutStr ( h, 'Press a key for speed, home for hold',
  571.                          1, 25, 7 );
  572.                 for i := 1 to 24 do
  573.                 begin
  574.                    str (i, s);
  575.                    PutStr ( h,Center (S, 10,'-'), 1+(i-1)*3, i, 14 );
  576.                    wait(1);
  577.                 end
  578.  
  579.              END (* Xwait *) .
  580. .pa
  581. è                                 WORD
  582.  
  583.  
  584.  
  585. Declaration: Function Word ( S : AnyString;
  586.                              N : Integer ) : AnyString;
  587.  
  588.  
  589. Purpose:     Returns word N of S.
  590.  
  591.  
  592.              Notes:
  593.  
  594.              1.  A word is any blank-delimited sequence of
  595.                  characters or a string of nonblank characters.
  596.  
  597.  
  598. Example:     Extract a word from a string.
  599.  
  600.  
  601.              Given:  S := 'The Lone Ranger's friend is Tonto.';
  602.  
  603.              Then:   T := Word ( S, 6 );
  604.  
  605.              Yields: T := 'Tonto.';
  606.  
  607.  
  608.              Note:
  609.  
  610.              1.  For a working routine of Word and other word
  611.                  functions, see the example for Words.
  612. .pa
  613. è                                WORDIND
  614.  
  615.  
  616.  
  617. Declaration: Function WordInd ( S : AnyString;
  618.                                 N : Integer ) : Integer;
  619.  
  620.  
  621. Purpose:     Returns the string position of word N in S.
  622.  
  623.  
  624.              Notes:
  625.  
  626.              1.  A word is any blank-delimited sequence of
  627.                  characters or a string of nonblank characters.
  628.  
  629.  
  630. Example:     Find the starting position of a word in a string.
  631.  
  632.  
  633.              Given:  S := 'These are the times that try our souls.';
  634.  
  635.              Then:   i := WordInd ( S, 4 );
  636.  
  637.              Yields: i := 15;  { Starting position of 'times' }
  638.  
  639.  
  640.              Note:
  641.  
  642.              1.  See Words below for a working routine using
  643.                  WordInd and the other word functions.
  644. .pa
  645. è                                 WORDS
  646.  
  647.  
  648.  
  649. Declaration: Function Words ( S : AnyString ) : Integer;
  650.  
  651.  
  652. Purpose:     Returns the number of words in S.
  653.  
  654.  
  655.              Notes:
  656.  
  657.              1.  A word is any blank-delimited sequence of
  658.                  characters or a string of nonblank characters.
  659.              2.  The string 'Turbo Pascal' has 2 words.
  660.  
  661.  
  662. Example:     Analyze and optionally modify user input until
  663.              user types 'Q' or 'q'.
  664.  
  665.              (*$IBoDecl *)
  666.              (*$IStrip  *)
  667.              (*$ICenter *)
  668.              (*$IRword  *)
  669.              (*$IWord   *)
  670.              (*$IWords  *)
  671.              (*$IWordInd*)
  672.              (*$ISpace  *)
  673.  
  674.              var
  675.                 Ts : AnyString;
  676.                 j  : Integer;
  677.  
  678.              BEGIN
  679.                 ClrScr;
  680.                 Write( Center ( 'Type a message for analysis.'+
  681.                                 ' Q to quit.',80,' '));
  682.                 Write( Center ( '''n , string'' replaces word' +  
  683.                                 ' n of previous message'+
  684.                                 ' with ''string''',80,' ') );
  685.                 window (1,3,80,25);
  686.                 repeat
  687.                    readln( S );
  688.                    S := space(S);
  689.                    if Length(S) > 0 then
  690.                    begin
  691.                       val ( word(S,1), i, ecode );
  692.                       if (ecode = 0) and (word(S,2) = ',') then
  693.                       begin
  694.                          j  := WordInd (S, 3);
  695.                          Ts := rword ( Ts , i, 
  696.                               copy ( S, j, Length(S)-j+1) );
  697.                          Writeln ( Ts );
  698.                       end
  699. è                      else
  700.                       begin
  701.                          Ts := S;
  702.                          Writeln ( S );
  703.                          i := 1 + Random(Words(Ts));
  704.                       end;
  705.                       GotoXY( WordInd(Ts,i), WhereY );
  706.                       writeln( #004 );
  707.                       Writeln( 'There are ',words(Ts),
  708.                                ' words in your message.');
  709.                       Writeln('There are ',length(word(Ts,i)),
  710.                               ' characters in word ',i);
  711.                    end (*  Length > 0 *);
  712.                 until (S = 'Q') or (S = 'q');
  713.                 window (1,1,80,25);
  714.  
  715.              END (*  Xwords *).
  716.